home *** CD-ROM | disk | FTP | other *** search
/ Developer CD Series 1996 May: Tool Chest / Developer CD Series May 1996 (Tool Chest) (Apple Computer) (1996).iso / Tool Chest / Development Tools & Languages / Dylan Related / Mindy / Mindy 1.2 - portable sources / elisp / dylan-mode.el next >
Encoding:
Text File  |  1995-03-15  |  33.7 KB  |  863 lines  |  [TEXT/ttxt]
  1. ;;; dylan-mode.el Implements indentation and basic support for Dylan (tm)
  2. ;;; programs.
  3.  
  4. ;;; Copyright (C) 1994  Carnegie Mellon University
  5. ;;;
  6. ;;; Bug reports, questions, comments, and suggestions should be sent by
  7. ;;; E-mail to the Internet address "gwydion-bugs@cs.cmu.edu".
  8. ;;;
  9. ;;; Author: Robert Stockton (rgs@cs.cmu.edu)
  10. ;;;
  11. ;;; This program is free software; you can redistribute it and/or modify
  12. ;;; it under the terms of the GNU General Public License as published by
  13. ;;; the Free Software Foundation; either version 1, or (at your option)
  14. ;;; any later version.
  15. ;;;
  16. ;;; This program is distributed in the hope that it will be useful,
  17. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19. ;;; GNU General Public License for more details.
  20. ;;;
  21. ;;; A copy of the GNU General Public License can be obtained from this
  22. ;;; program's author (send electronic mail to "gwydion-bugs@cs.cmu.edu")
  23. ;;; or from the Free Software Foundation, Inc., 675 Mass Ave,
  24. ;;; Cambridge, MA 02139, USA.
  25.  
  26. ;;; User modifiable variables
  27. (defvar dylan-indent 2
  28.   "* Number of spaces to indent each sub-block.")
  29. (defvar dylan-outdent-arrows t
  30.   "* Should '=>' in function definitions be treated specially?")
  31.  
  32. ;;; Version 1.0
  33. ;;; History:
  34. ;;;   version 0.1: Quick one day hack -- appears to be useful
  35. ;;;   version 0.2: Added font lock support
  36. ;;;   version 0.3: Added misc features to work towards "industrial strength"
  37. ;;;     Detects "continuation lines" and indents them specially
  38. ;;;     Basic comment support
  39. ;;;     Added "symbol character" support (with second syntax table for
  40. ;;;     indentation and font-lock)
  41. ;;;     Added indentation support for "elseif" and "exception" clauses
  42. ;;;     Cleaned up a number of old bugs
  43. ;;;   version 0.4: Brought into compliance with new "post-DN22" syntax
  44. ;;;     new comment syntax
  45. ;;;     new "return types" syntax
  46. ;;;     accepts sealed, open, concrete, and abstract in class definitions
  47. ;;;     fixed bug in comment indentation
  48. ;;;     fine tune font-lock-regexps for "define ..."
  49. ;;;   version 0.5:
  50. ;;;     Added "dylan-insert-block-end" function.
  51. ;;;     Fixed bug in short circuiting indentation outside top level forms.
  52. ;;;   version 1.0:
  53. ;;;     Major code reorganization
  54. ;;;     Added full case statement support
  55. ;;;     Fixed "continuations" at top level
  56. ;;;     Added "beginning-of-form" and "end-of-form" commands
  57. ;;;     Fixed support for character literals and for "quoted" quote chars
  58. ;;;   version 1.1:
  59. ;;;     The "font-lock-mode" support no longer interferes with other language
  60. ;;;     modes.   (Thanks to emg@hip.atr.co.jp)
  61. ;;;   version 1.2:
  62. ;;;     Fixes for various bugs (thanks to wlott@cs.cmu.edu):
  63. ;;;       "foo-end;" was mistaken for the end of a compound statement
  64. ;;;       syntax tables sometimes ended in an odd state after errors
  65. ;;;       indentation sometimes failed if parens weren't balanced
  66. ;;;   version 1.3:
  67. ;;;     Added font lock support for "sealed", "open", etc.
  68. ;;;   version 1.4:
  69. ;;;     Added special-case support for generic function "continuations" and
  70. ;;;     for outdenting "=>" in function definitions.
  71. ;;;   version 1.5:
  72. ;;;     Adjusted regexps to accept "primary" and "free" adjectives
  73. ;;;     Mentioned dylan-outdent-arrows in the documentation
  74. ;;;     Added a space to comment-start
  75. ;;;   version 1.6:
  76. ;;;     Fixed bug in generic function continuations from 1.4.
  77. ;;;   version 1.7:
  78. ;;;     Merged changes from Joseph Wilson (jnw@cis.ufl.edu) to facilitate use 
  79. ;;;     within more general modes.
  80.  
  81. ;;; Known limitations:
  82. ;;;   Limited support for block (i.e. "/*") comments
  83. ;;;   Indentation for lines inside "{}" blocks is wrong
  84. ;;;   Magic => support doesn't work at end of buffer
  85.  
  86. ;;; Desired features:
  87. ;;;   Copy indentation from first statement in body
  88. ;;;   Beginning of defun and end of defun
  89. ;;;   Delete-backward-expanding-tabs
  90. ;;;   More consistency in font-lock highlighting
  91. ;;;     font-lock-mode should italicize the function in "block (return)"
  92.  
  93. ;;; Private definitions
  94. (defvar dyl-start-keywords
  95.   '("if" "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+method"
  96.     "define\\([ \t]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t]+class"
  97.     "define[ \t]+library" "define[ \t]+module"
  98.     "block" "begin" "method"
  99.     "case" "for" "select" "unless" "until" "while")
  100.   "Patterns that signal the start of a nested 'body'.")
  101.  
  102. (defvar dyl-start-expressions
  103.   '(("if[ \t\n]*" "")
  104.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "[ \t\n]*=>[^;]+;")
  105.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "[ \t\n]*;")
  106.     ("\\(define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t\n]+\\)?method[ \t\n]+[^\( ]*[ \t\n]*" "")
  107.     ("define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t\n]+class[ \t\n]+[^\( ]+[ \t\n]*" "")
  108.     ("block[ \t\n]*" "")
  109.     ("for[ \t\n]*" "")
  110.     ("select[ \t\n]*" "")
  111.     ("unless[ \t\n]*" "")
  112.     ("until[ \t\n]*" "")
  113.     ("while[ \t\n]*" "")
  114.     "define[ \t\n]+library[ \t\n]+[^ \t\n]+"
  115.     "define[ \t\n]+module[ \t\n]+[^ \t\n]+"
  116.     "begin" "case" "(")
  117.   "Patterns which match that portion of a 'compound statement' which precedes
  118. the 'body'.  This is used to determine where the first statement 
  119. begins for indentation purposes.  
  120.  
  121. Contains a list of patterns, each of which is either a regular 
  122. expression or a list of regular expressions.  A set of balanced 
  123. parens will be matched between each list element.")
  124.  
  125. (defvar dyl-end-keywords
  126.   '("end[ \t]+if" "end[ \t]+method" "end[ \t]+class" "end[ \t]+library"
  127.     "end[ \t]+module" "end[ \t]+block"
  128.     "end[ \t]+case" "end[ \t]+select" "end[ \t]+for" "end[ \t]+unless"
  129.     "end[ \t]+until" "end[ \t]+while" "end")
  130.   "Patterns which end a compound statement.")
  131.  
  132. (defvar dyl-separator-keywords
  133.   '("finally" "exception" "cleanup" "else" "elseif")
  134.   "Patterns act as separators in compound statements.  This may include any
  135. general pattern which must be indented specially.")
  136.  
  137. (defvar dyl-other-keywords
  138.   '("above" "below" "by" "define[ \t]+constant" "define[ \t]+variable" "from"
  139.     "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+generic"
  140.     "handler" "in" "instance" "let" "local" "otherwise"
  141.     "slot" "subclass" "then" "to" "virtual")
  142.   "Keywords which do not require special indentation handling, but which
  143. should be highlighted if this capability exists.")
  144.  
  145. (defun dylan-mode-commands (map)
  146.   (define-key map ";" 'dylan-insert-and-indent)
  147.   (define-key map "," 'dylan-insert-and-indent)
  148.   (define-key map ">" 'dylan-arrow-insert)
  149.   (define-key map "\n" 'dylan-newline-and-indent)
  150.   (define-key map "\t" 'dylan-indent-line)
  151.   (define-key map "\ea" 'dylan-beginning-of-form)
  152.   (define-key map "\ee" 'dylan-end-of-form)
  153.   (define-key map "\e)" 'dylan-insert-block-end))
  154.  
  155. (defvar dylan-mode-map ()
  156.   "Keymap used in dylan mode.")
  157. (if (not dylan-mode-map)
  158.     (progn
  159.       (setq dylan-mode-map (make-sparse-keymap))
  160.       (dylan-mode-commands dylan-mode-map)))
  161.  
  162. (defvar dylan-mode-abbrev-table nil
  163.   "Abbrev table in use in dylan-mode buffers.  Provides 'hooked' 
  164. abbreviations to reindent lines containing 'separator' keywords.")
  165. (if (not dylan-mode-abbrev-table)
  166.     (progn
  167.       (define-abbrev-table 'dylan-mode-abbrev-table ())
  168.       (define-abbrev dylan-mode-abbrev-table "end" "end" 'reindent-line)
  169.       (let ((list dyl-separator-keywords))
  170.     (while list
  171.       (define-abbrev dylan-mode-abbrev-table
  172.         (car list) (car list) 'reindent-line)
  173.       (setq list (cdr list))))))
  174.  
  175. (defvar dylan-mode-syntax-table nil
  176.   "User level syntax table.  Provides support for forward-word, etc.")
  177. (defvar dylan-indent-syntax-table nil
  178.   "Special syntax table which is used by the indent and font-lock code 
  179. for finding keywords and the like.  This is necessary because there is
  180. no equivalent to '\b' for identifiers.")
  181.  
  182. (if (not dylan-mode-syntax-table)
  183.     (progn
  184.       (setq dylan-mode-syntax-table (make-syntax-table))
  185.       (modify-syntax-entry ?_ "_" dylan-mode-syntax-table)
  186.       (modify-syntax-entry ?- "_" dylan-mode-syntax-table)
  187.       (modify-syntax-entry ?< "_" dylan-mode-syntax-table)
  188.       (modify-syntax-entry ?> "_" dylan-mode-syntax-table)
  189.       (modify-syntax-entry ?? "_" dylan-mode-syntax-table)
  190.       (modify-syntax-entry ?! "_" dylan-mode-syntax-table)
  191.       (modify-syntax-entry ?= "_" dylan-mode-syntax-table)
  192.       (modify-syntax-entry ?: "_" dylan-mode-syntax-table)
  193.       (modify-syntax-entry ?' "\"" dylan-mode-syntax-table)
  194.       (modify-syntax-entry ?\f " " dylan-mode-syntax-table)
  195.       ; different emacs version handle comments differently
  196.       (cond ((and (boundp 'running-lemacs) running-lemacs)
  197.          (modify-syntax-entry ?\n "> b" dylan-mode-syntax-table)
  198.          (modify-syntax-entry ?/ "_ 1456" dylan-mode-syntax-table)
  199.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table))
  200.         ((string-lessp emacs-version "19")
  201.          ; emacs 18 doesn't have sufficient support to grok "//" comments
  202.          ; so we must (regretfully) leave them out
  203.          (modify-syntax-entry ?/ "_ 14" dylan-mode-syntax-table)
  204.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table))
  205.         (t
  206.          (modify-syntax-entry ?\n "> b" dylan-mode-syntax-table)
  207.          (modify-syntax-entry ?/ "_ 1456b2" dylan-mode-syntax-table)
  208.          (modify-syntax-entry ?\* "_ 23" dylan-mode-syntax-table)))
  209.       (setq dylan-indent-syntax-table
  210.         (copy-syntax-table dylan-mode-syntax-table))
  211.       (modify-syntax-entry ?_ "w" dylan-indent-syntax-table)
  212.       (modify-syntax-entry ?- "w" dylan-indent-syntax-table)
  213.       (modify-syntax-entry ?/ "w 1456" dylan-mode-syntax-table)
  214.       (modify-syntax-entry ?\* "w 23" dylan-mode-syntax-table)
  215.       (modify-syntax-entry ?< "w" dylan-indent-syntax-table)
  216.       (modify-syntax-entry ?> "w" dylan-indent-syntax-table)
  217.       (modify-syntax-entry ?? "w" dylan-indent-syntax-table)
  218.       (modify-syntax-entry ?! "w" dylan-indent-syntax-table)
  219.       (modify-syntax-entry ?= "w" dylan-indent-syntax-table)
  220.       (modify-syntax-entry ?: "w" dylan-indent-syntax-table)))
  221.  
  222. ;;; Ugly code which you don't want to look at.
  223. (defvar dylan-comment-pattern "//.*$"
  224.   "Internal pattern for finding comments in dylan code.  Currently only
  225. handles end-of-line comments.")
  226.  
  227. (defun make-pattern (start &rest list)
  228.   "Builds a search pattern that matches any of the patterns passed to it.
  229. Makes sure that it doesn't match partial words."
  230.   (let ((str (concat "\\b" start "\\b")))
  231.     (while list
  232.       (setq str (concat str "\\|\\b" (car list) "\\b"))
  233.       (setq list (cdr list)))
  234.     str))
  235.  
  236. (defvar dyl-keyword-pattern (apply 'make-pattern dyl-start-keywords))
  237. (defvar dyl-end-keyword-pattern (apply 'make-pattern dyl-end-keywords))
  238. (defvar separator-word-pattern (apply 'make-pattern dyl-separator-keywords))
  239. (defvar dyl-other-pattern (apply 'make-pattern dyl-other-keywords))
  240.  
  241. (defun look-back (regexp)
  242.   "Attempts to find a match for \"regexp\" immediately preceding the current
  243. point.  In order for this to work properly, the search string must end with
  244. '$'.  Also note that this will only work within the current line."
  245.   (save-excursion
  246.     (save-restriction
  247.       (let ((dot (point)))
  248.     (beginning-of-line)
  249.     (narrow-to-region dot (point))
  250.     (re-search-forward regexp nil t)))))
  251.  
  252. (defvar find-keyword-pattern (concat "[][)(}{\"']\\|\\bdefine\\b\\|"
  253.                      dyl-end-keyword-pattern 
  254.                      "\\|" dyl-keyword-pattern)
  255.   "A pattern which matches the beginnings and ends of various 'blocks',
  256. including parenthesized expressions.")
  257.  
  258. (defvar dylan-beginning-of-form-pattern (concat "[;,]\\|=>\\|" find-keyword-pattern
  259.                     "\\|" separator-word-pattern)
  260.   "Like 'find-keyword-pattern' but matches statement terminators as well.")
  261.  
  262. (defun dylan-find-keyword (&optional match-statement-end in-case no-commas)
  263.   "Moves the point backward to the beginning of the innermost enclosing
  264. 'compound statement' or set of parentheses.  Returns t on success and
  265. nil otherwise."
  266.   (if (re-search-backward (if match-statement-end
  267.                  dylan-beginning-of-form-pattern
  268.                find-keyword-pattern) nil t)
  269.       (cond ((look-back dylan-comment-pattern)
  270.          (goto-char (match-beginning 0))
  271.          (dylan-find-keyword match-statement-end in-case no-commas))
  272.         ((looking-at "[])}'\"]")
  273.          (condition-case nil
  274.          (progn 
  275.            (forward-char 1)
  276.            (backward-sexp 1)
  277.            (dylan-find-keyword match-statement-end in-case no-commas))
  278.            (error nil)))
  279.         ((and (looking-at "define")    ; non-nesting top level form
  280.           (not (looking-at dyl-keyword-pattern)))
  281.          nil)
  282.         ((or (looking-at "end")
  283.          (and (look-back "\\bend[ \t]+$") (backward-word 1)))
  284.          (dylan-find-keyword)
  285.          (if (or (and (looking-at "method") (look-back "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+$"))
  286.              (looking-at "define"))
  287.          nil
  288.            (dylan-find-keyword match-statement-end in-case no-commas)))
  289.         ; hack for overloaded uses of "while" and "until" reserved words
  290.         ((or (looking-at "until") (looking-at "while"))
  291.          (if (save-excursion
  292.            (condition-case nil
  293.                (progn 
  294.              (backward-up-list 1)
  295.              (backward-sexp 1)
  296.              (looking-at "for\\b")) (error nil)))
  297.          (backward-up-list 1))
  298.          t)
  299.         ((and (looking-at separator-word-pattern)
  300.           (not match-statement-end))
  301.          (dylan-find-keyword match-statement-end in-case no-commas))
  302.         ((and (looking-at ";") (not match-statement-end))
  303.          (dylan-find-keyword match-statement-end in-case no-commas))
  304.         ((and (looking-at ",") (or (not match-statement-end) no-commas))
  305.          (dylan-find-keyword match-statement-end in-case no-commas))
  306.         ((and (looking-at "=>") (not (and match-statement-end in-case)))
  307.          (dylan-find-keyword match-statement-end in-case no-commas))
  308.         (t t))
  309.     (goto-char (point-min))
  310.     nil))
  311.  
  312. (defun dylan-find-end (&optional match-statement-end in-case no-commas)
  313.   "Moves the point forward to the end of the innermost enclosing
  314. 'compound statement' or set of parentheses.  Returns t on success and
  315. nil otherwise."
  316.   (if (re-search-forward (if match-statement-end
  317.                  dylan-beginning-of-form-pattern
  318.                find-keyword-pattern) nil t)
  319.       (let ((match-start (match-beginning 0)))
  320.     (cond ((look-back dylan-comment-pattern)
  321.            (forward-line)
  322.            (dylan-find-end match-statement-end in-case no-commas))
  323.           ((look-back "[[({'\"]$")
  324.            (condition-case nil
  325.            (progn 
  326.              (backward-char 1)
  327.              (forward-sexp 1)
  328.              (dylan-find-end match-statement-end in-case no-commas))
  329.          (error nil)))
  330.           ((look-back "[])}]$") t)
  331.           ((look-back "define$")    ; special case for top-level forms
  332.            (dylan-find-end t nil nil)
  333.            nil)
  334.           ((look-back "\\bend\\([ \t]+\\w+\\)?$")
  335.            (if (and (not (looking-at "[ \t]+\\(end\\|=>\\)\\b"))
  336.             (looking-at "[ \t]+\\w+"))
  337.            (goto-char (match-end 0)))
  338.            t)
  339.           ; hack for overloaded uses of "while" and "until" reserved words
  340.           ((look-back "until$\\|while$")
  341.            (if (save-excursion
  342.              (condition-case nil
  343.              (progn 
  344.                (backward-up-list 1)
  345.                (backward-sexp 1)
  346.                (looking-at "for\\b")) (error nil)))
  347.            (up-list 1))
  348.            t)
  349.           ((save-excursion (goto-char match-start)
  350.                    (looking-at separator-word-pattern))
  351.            t)
  352.           ((look-back ";$")
  353.            (if (not match-statement-end)
  354.            (dylan-find-end match-statement-end in-case no-commas)
  355.          t))
  356.           ((look-back ",$")
  357.            (if (or (not match-statement-end) no-commas)
  358.            (dylan-find-end match-statement-end in-case no-commas)
  359.          t))
  360.           ((look-back "=>$")
  361.            (if (not (and match-statement-end in-case))
  362.            (dylan-find-end match-statement-end in-case no-commas)
  363.          t))
  364.           (t                ; start compound statement
  365.            (if (save-excursion (goto-char match-start)
  366.                    (looking-at "define"))
  367.            (progn (dylan-find-end) nil)
  368.          (dylan-find-end)
  369.          (dylan-find-end match-statement-end in-case no-commas)))))
  370.     (goto-char (point-max))
  371.     nil))
  372.  
  373. (defun dylan-skip-star-comment-backward ()
  374.   "Utility function for 'dylan-skip-whitespace-backward'.  Finds beginning
  375. of enclosing '/*' comment.  Deals properly with nested '/*' and with '//'."
  376.   (re-search-backward "/\\*\\|\\*/")
  377.   (while (cond ((look-back dylan-comment-pattern)
  378.         (goto-char (match-beginning 0)))
  379.            ((looking-at "\\*/")
  380.         (dylan-skip-star-comment-backward))
  381.            (t nil))
  382.     (re-search-backward "/\\*\\|\\*/"))
  383.   t)
  384.  
  385. (defun dylan-skip-star-comment-forward ()
  386.   "Utility function for 'dylan-skip-whitespace-forward'.  Finds end
  387. of enclosing '/*' comment.  Deals properly with nested '/*' and with '//'."
  388.   (re-search-forward "/\\*\\|\\*/")
  389.   (while (cond ((look-back dylan-comment-pattern)
  390.         (end-of-line))
  391.            ((look-back "/\\*$")
  392.         (dylan-skip-star-comment-forward))
  393.            (t nil))
  394.     (re-search-forward "/\\*\\|\\*/"))
  395.   t)
  396.  
  397. (defvar non-whitespace-string "\\s_\\|\\s(\\|\\s\"\\|\\s$\\|\\s<\\|\\s/\\|\\sw\\|\\s.\\|\\s)\\|\\s'\\|\\s\\"
  398.   "A magic search string which matches everything but 'whitespace'.  Used
  399. because old version of emacs don't have 'skip-syntax-backward'.")
  400.  
  401. (defun dylan-skip-whitespace-backward ()
  402.   "Skips over both varieties of comments and other whitespace characters."
  403.   ; skip syntactic whitespace
  404.   (if (re-search-backward non-whitespace-string nil t)
  405.       (forward-char)
  406.     (goto-char 0))
  407.   ; skip comments
  408.   (while (cond ((look-back dylan-comment-pattern)
  409.         (goto-char (match-beginning 0)))
  410.            ((look-back "\\*/$")
  411.         (goto-char (match-beginning 0))
  412.         (dylan-skip-star-comment-backward))
  413.            (t nil))
  414.     (if (re-search-backward non-whitespace-string nil t)
  415.     (forward-char)
  416.       (goto-char 0))))
  417.  
  418. (defun dylan-skip-whitespace-forward ()
  419.   "Skips over both varieties of comments and other whitespace characters."
  420.   ; skip syntactic whitespace
  421.   (re-search-forward "\\(\\s \\|\\s>\\)*")
  422.   ; skip comments
  423.   (while (cond ((looking-at dylan-comment-pattern)
  424.         (goto-char (match-end 0))
  425.         t)
  426.            ((looking-at "/\\*")
  427.         (goto-char (match-end 0))
  428.         (dylan-skip-star-comment-forward))
  429.            (t nil))
  430.     (re-search-forward "\\(\\s \\|\\s>\\)*")))
  431.  
  432. (defun aux-find-body-start (clauses)
  433.   "Helper function for 'find-body-start'"
  434.   (save-excursion
  435.     (cond ((null clauses) (point))
  436.       ((looking-at (car clauses))
  437.        (if (null (cdr clauses))
  438.            (match-end 0)
  439.          (goto-char (match-end 0))
  440.          (and (looking-at "[[({]")
  441.           (condition-case nil (forward-list) (error nil))
  442.           (aux-find-body-start (cdr clauses))))))))
  443.  
  444. (defun find-body-start (exprs)
  445.   "When passed 'dyl-start-expressions', processes it to find the beginning
  446. of the first statment in the compound statement which starts at the 
  447. current point."
  448.   (cond ((null exprs) (point-max))
  449.     ((listp (car exprs))
  450.      (or (aux-find-body-start (car exprs)) (find-body-start (cdr exprs))))
  451.     (t (if (looking-at (car exprs))
  452.            (match-end 0)
  453.          (find-body-start (cdr exprs))))))
  454.  
  455. (defun backward-dylan-statement (&optional in-case no-commas)
  456.   "Moves the cursor to some undefined point between the previous 'statement'
  457. and the current one.  If we are already between statements, move back one 
  458. more."
  459.   (unwind-protect
  460.       ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  461.       ;; install a new syntax table and restore the old one when done
  462.       (progn
  463.     (set-syntax-table dylan-indent-syntax-table)
  464.     (dylan-skip-whitespace-backward)
  465.     (let* ((dot (point)))
  466.       ;; skip over "separator words"
  467.       (if (save-excursion
  468.         (and (re-search-backward separator-word-pattern nil t)
  469.              (if (not (looking-at "exception\\|elseif"))
  470.              (forward-word 1)
  471.                (goto-char (match-end 0))
  472.                (condition-case nil (forward-list 1)
  473.              (error nil))
  474.                t)
  475.              (>= (point) dot)))
  476.           (progn (re-search-backward separator-word-pattern nil t)
  477.              (dylan-skip-whitespace-backward)))
  478.       (if (look-back "[,;]$\\|=>$")
  479.           (backward-char))
  480.       (cond ((not (dylan-find-keyword t in-case no-commas))
  481.          (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  482.              (goto-char (match-beginning 0))))
  483.         ((looking-at separator-word-pattern)
  484.          (let ((start (point)))
  485.            (cond ((looking-at "\\(exception\\|elseif\\)[ \t\n]*(")
  486.               (goto-char (match-end 1))
  487.               (condition-case nil (forward-list 1)
  488.                 (error nil)))
  489.              (t (forward-word 1)))
  490.            (if (>= (point) dot)
  491.                (progn (goto-char start)
  492.                   (backward-dylan-statement in-case no-commas)))))
  493.         ((looking-at "[;,]\\|=>")
  494.          (goto-char (match-end 0)))
  495.         (t
  496.          ;; check whether we were already at the first "form" in an
  497.          ;; enclosing block
  498.          (let ((first (find-body-start dyl-start-expressions)))
  499.            (if (< first dot)
  500.                (goto-char first)
  501.              (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  502.              (goto-char (match-beginning 0)))))))))
  503.     (set-syntax-table dylan-mode-syntax-table)))
  504.  
  505. (defun dylan-beginning-of-form ()
  506.   "Finds the beginning of the innermost 'statement' which contains or
  507. terminates at the current point."
  508.   (interactive)
  509.   (backward-dylan-statement)
  510.   (dylan-skip-whitespace-forward))
  511.  
  512. (defun forward-dylan-statement (&optional in-case no-commas)
  513.   "Moves the cursor to some undefined point between the current 'statement'
  514. and the next one.  If we are already between statements, move forward one 
  515. more."
  516.   (unwind-protect
  517.       ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  518.       ;; install a new syntax table and restore the old one when done
  519.       (progn
  520.     (set-syntax-table dylan-indent-syntax-table)
  521.     (dylan-skip-whitespace-forward)
  522.     (let* ((dot (point)))
  523.       ;; skip over "separator words"
  524.       (if (looking-at separator-word-pattern)
  525.           (if (not (looking-at "exception\\|elseif"))
  526.              (forward-word 1)
  527.                (goto-char (match-end 0))
  528.                (condition-case nil (forward-list 1)
  529.              (error nil))))
  530.       (cond ((not (dylan-find-end t in-case no-commas))
  531.          (if (look-back "\\(define\\|local\\)[ \t]+")    ; hack
  532.              (goto-char (match-beginning 0))))
  533.         (t)))
  534.     (cond ((looking-at "[,;]$") (forward-char))
  535.           ((looking-at "=>") (forward-word 1))))
  536.     (set-syntax-table dylan-mode-syntax-table)))
  537.  
  538. (defun dylan-end-of-form ()
  539.   "Finds the end of the innermost 'statement' which contains or begins
  540. at the current point."
  541.   (interactive)
  542.   (forward-dylan-statement))
  543.  
  544. (defun indent-if-continuation (term-char line-start block-start
  545.                      &optional in-case in-paren)
  546.   (save-excursion
  547.     (goto-char line-start)
  548.     (let ((arrow (and dylan-outdent-arrows (looking-at "=>"))))
  549.       (dylan-skip-whitespace-backward)
  550.       (if (look-back "finally$")    ; special case -- this one is tricky
  551.       0                ; because "for" can have empty bodies
  552.     (let ((real-start (point)))
  553.       (backward-dylan-statement in-case)
  554.       (dylan-skip-whitespace-forward)
  555.       (cond ((and (= block-start 0) (not (looking-at "define")))
  556.          0)            ; special case for beginning of file
  557.         ((= real-start block-start) 0)
  558.         ((< (point) block-start)
  559.          (+ dylan-indent (if (and arrow (not in-case)) -3 0)))
  560.         ((< (save-excursion
  561.               (forward-dylan-statement in-case
  562.                            (equal term-char ";"))
  563.               (point)) line-start)
  564.          0)
  565.         ;; Give continuations of generic functions extra
  566.         ;; indentation to match what happens with method
  567.         ;; declarations.  This is an odd special case, but some
  568.         ;; folks like it.  If you don't, comment out the next 3
  569.         ;; lines.
  570.         ((looking-at
  571.           "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+generic")
  572.          (+ dylan-indent dylan-indent (if arrow -3 0)))
  573.         (t dylan-indent)))))))
  574.  
  575. (defun dylan-indent-line (&optional ignore-case extra-indent)
  576.   "Indents a line of dylan code according to its nesting."
  577.   ;; The "ignore-case" and "extra-indent" vars are used for recursive
  578.   ;; calls so that the special code for handling case statements won't
  579.   ;; recurse infinitely.
  580.   (interactive)
  581.   (setq extra-indent (or extra-indent 0))
  582.   (unwind-protect
  583.       (save-excursion
  584.     ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  585.     ;; install a new syntax table and restore the old one when done
  586.     (set-syntax-table dylan-indent-syntax-table)
  587.     (beginning-of-line)
  588.     (delete-horizontal-space)
  589.     (let* ((body-start)        ; beginning of "body" of enclosing
  590.                     ; compound statement
  591.            (was-paren)        ; t if in parenthesized expr.
  592.            (in-case)        ; t if in "case" or "select" stmt
  593.            (block-indent        ; indentation of enclosing comp. stmt
  594.         (save-excursion
  595.           (if (not (dylan-find-keyword))
  596.               nil
  597.             (and (looking-at "method")
  598.              (look-back "define\\([ \t\n]+\\(sealed\\|open\\)\\)*[ \t]+$")
  599.              (goto-char (match-beginning 0)))
  600.             (and (looking-at "[[({]") (setq was-paren t))
  601.             (and (looking-at "select\\|case") (setq in-case t))
  602.             (setq body-start (find-body-start dyl-start-expressions))
  603.             (+ (current-column) extra-indent))))
  604.            (indent            ; correct indentation for this line
  605.         (cond ((not block-indent)
  606.                (indent-if-continuation ";" (point) 0))
  607.               ;; some keywords line up with start of comp. stmt 
  608.               ((looking-at separator-word-pattern) block-indent)
  609.               ;; end keywords line up with start of comp. stmt 
  610.               ((looking-at dyl-end-keyword-pattern) block-indent)
  611.               ;; parenthesized expressions (separated by commas)
  612.               (in-case
  613.                ; if the line is blank, we pick an arbitrary
  614.                ; indentation for now.  We judge the "proper"
  615.                ; indentation by how the statement is punctuated once
  616.                ; it is finished
  617.                (cond ((looking-at "^$")
  618.                   (if (save-excursion
  619.                     ; Look for end of prev statement.  This
  620.                     ; is hairier than it should be because
  621.                     ; we may be at the end of the buffer
  622.                     (let ((dot (point)))
  623.                       (forward-dylan-statement t)
  624.                       (dylan-skip-whitespace-backward)
  625.                       (if (> (point) dot)
  626.                       (backward-dylan-statement t))
  627.                       (look-back ";$\\|=>$")))
  628.                   (+ block-indent dylan-indent dylan-indent
  629.                      (indent-if-continuation "," (point)
  630.                                  body-start t))
  631.                 (+ block-indent dylan-indent 
  632.                    (indent-if-continuation "," (point)
  633.                                body-start t))))
  634.                  ((save-excursion
  635.                 (forward-dylan-statement t)
  636.                 (look-back ",$\\|=>$"))
  637.                   (+ block-indent dylan-indent 
  638.                  (indent-if-continuation "," (point)
  639.                              body-start t)))
  640.                  (t (+ block-indent dylan-indent dylan-indent
  641.                    (indent-if-continuation "," (point)
  642.                                body-start t)))))
  643.               (was-paren (+ block-indent 1
  644.                     (indent-if-continuation "," (point)
  645.                                 body-start)))
  646.               ;; statements (separated by semi-colons)
  647.               (t (+ block-indent dylan-indent
  648.                 (indent-if-continuation ";" (point)
  649.                             body-start))))))
  650.       (indent-to-column indent)))
  651.     ;; put the cursor where the user is likely to want it.
  652.     (and (= (current-column) 0) (skip-chars-forward " \t"))
  653.     (set-syntax-table dylan-mode-syntax-table)))
  654.  
  655. (defun in-case ()
  656.   "Checks to see whether we are immediately nested in a 'case' or 'select'
  657. statement.  Is used to provide special re-indentation for ',', ';', and '=>'."
  658.   (save-excursion
  659.     (dylan-find-keyword)
  660.     (looking-at "case\\|select")))
  661.  
  662. (defun reindent-line ()
  663.   (interactive)
  664.   (save-excursion (funcall indent-line-function)))
  665.  
  666. (defun dylan-newline-and-indent ()
  667.   (interactive)
  668.   (expand-abbrev)
  669.   (newline-and-indent))
  670.  
  671. (if (and (boundp 'running-lemacs) running-lemacs)
  672.     (defun this-command-chars ()
  673.       (events-to-keys (this-command-keys)))
  674.   (defun this-command-chars ()
  675.     (this-command-keys)))
  676.  
  677. (defun dylan-insert-and-indent ()
  678.   "Make ';' and ',' do re-indentation for case statements."
  679.   (interactive)
  680.   (self-insert-command 1)
  681.   (if (in-case)
  682.       (save-excursion
  683.     ;; These things are finicky around EOF, so use "point-marker" instead
  684.     ;; of "point" so that re-indentations won't yield infinite loops
  685.     (let ((dot (point-marker)))
  686.       (backward-dylan-statement t)
  687.       (dylan-skip-whitespace-forward)
  688.       (while (< (point) (marker-position dot))
  689.         (funcall indent-line-function)
  690.         (forward-line 1))))))
  691.  
  692. (defun dylan-arrow-insert ()
  693.   "Make '=>' do re-indentation for case statements and function declarations."
  694.   (interactive)
  695.   (if (not (= (preceding-char) ?=))
  696.       (self-insert-command 1)
  697.     (self-insert-command 1)
  698.     (save-excursion
  699.       (if (in-case)
  700.       (let ((dot (point-marker)))
  701.         (backward-dylan-statement t)
  702.         (dylan-skip-whitespace-forward)
  703.         (while (< (point) (marker-position dot))
  704.           (funcall indent-line-function)
  705.           (forward-line 1)))
  706.     (funcall indent-line-function)))))
  707.  
  708.  
  709. ;;; This intensely DWIMish function tries to insert whatever text is needed to
  710. ;;; finish off the enclosing indentation context.
  711. (defun dylan-insert-block-end ()
  712.   "Insert whatever text is needed to finish off the enclosing indentation
  713. context (i.e. \"block\").  Makes educated guesses about whether newlines
  714. and closing punctuation are needed."
  715.   (interactive)
  716.   (let* ((here (point))
  717.      (terminator)
  718.      (need-newline)
  719.      (str
  720.       (unwind-protect
  721.           (save-excursion
  722.         ;; Because "\b" doesn't work with "symbol-chars" we temporarily
  723.         ;; install a new syntax table and restore the old one when done
  724.         (set-syntax-table dylan-indent-syntax-table)
  725.         (if (not (dylan-find-keyword))
  726.             (error "No nesting block."))
  727.         ; need newline if multi-line block and not "("
  728.         (setq need-newline (not (or (looking-at "[[({]")
  729.                         (save-excursion (end-of-line)
  730.                                 (>= (point) here)))))
  731.         (setq terminator
  732.               (save-excursion
  733.             (cond ((not (dylan-find-keyword)) ";")
  734.                   ((looking-at "[[({]") "")
  735.                   (t ";"))))
  736.         (if (looking-at "define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)\\)*[ \t]*")    ; find the actual word
  737.             (goto-char (match-end 0)))
  738.         (if (looking-at
  739.              "\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|free\\)[ \t]*")
  740.             (goto-char (match-end 0)))
  741.         (cond ((looking-at "begin") (concat " end" terminator))
  742.               ((looking-at "\\[") "]")
  743.               ((looking-at "(") ")")
  744.               ((looking-at "{") "}")
  745.               ((or (looking-at "\\(method\\|class\\)\\([ \t]+\\w+\\)?")
  746.                (looking-at "\\(library\\|module\\)[ \t]+\\w+")
  747.                (looking-at "\\w+"))
  748.                (concat " end "
  749.                    (buffer-substring (match-beginning 0)
  750.                          (match-end 0))
  751.                    terminator))
  752.               (t (concat " end" terminator))))
  753.         (set-syntax-table dylan-mode-syntax-table))))
  754.     (if need-newline
  755.     (progn
  756.       (beginning-of-line)
  757.       (if (looking-at "[ \t]*$")
  758.           (delete-horizontal-space)
  759.         (end-of-line)
  760.         (newline))))
  761.     (let* ((start (point))
  762.        (end (progn (insert str) (point))))
  763.       (goto-char start)
  764.       (while (re-search-forward "[ \t\n]+" end t)
  765.     (replace-match " "))
  766.       (goto-char end)
  767.       (reindent-line))))
  768.  
  769.  
  770. (defun dylan-mode-variables ()
  771.   ;; Use value appropriate for font-lock-mode now.  Reset after running hooks.
  772.   (set-syntax-table dylan-indent-syntax-table)
  773.   (make-local-variable 'indent-line-function)
  774.   (setq indent-line-function 'dylan-indent-line)
  775.   (make-local-variable 'comment-start)
  776.   (setq comment-start "//")
  777.   (make-local-variable 'comment-start-skip)
  778.   (setq comment-start-skip "//+[ \t]*\\|/\\*[ \t]*")
  779.   (make-local-variable 'parse-sexp-ignore-comments)
  780.   (setq parse-sexp-ignore-comments t)
  781.   (setq local-abbrev-table dylan-mode-abbrev-table)
  782.   (make-local-variable 'after-change-function)
  783.   (setq after-change-function nil)
  784.   (run-hooks 'dylan-mode-hook)
  785.   ;; This is the table the user should always see, even though the indent and
  786.   ;; font lock code both reset it temporarily.
  787.   (set-syntax-table dylan-mode-syntax-table))
  788.  
  789. (defun dylan-mode ()
  790.   "Major mode for editing dylan programs.
  791.  
  792. Tab and newline do dylan specific indentation.
  793. '//' comments are handled completely and '/*' comments marginally.
  794. Supports font-lock-mode under emacs 19 and lucid emacs.
  795.  
  796. The following bindings are available traversing and editing dylan code:
  797.   \\[dylan-beginning-of-form]
  798.     Moves to the beginning of the current 'statement'.
  799.   \\[dylan-end-of-form]
  800.     Moves to the end of the current 'statement'.
  801.   \\[dylan-insert-block-end]
  802.     Insert the appropriate text to close the current 'block'.
  803.  
  804. The default indentation level is controlled by the 'dylan-indent' variable.
  805. The default is 2 spaces.
  806.  
  807. By default, the mode uses a special indentation level for function return 
  808. declarations which lines up parameter declarations with return type 
  809. declarations.  This special feature may be turned off by setting 
  810. 'dylan-outdent-arrows' to nil.
  811. \\{dylan-mode-map}"
  812.   (interactive)
  813.   (abbrev-mode 1)
  814.   (use-local-map dylan-mode-map)
  815.   (setq major-mode 'dylan-mode)
  816.   (setq mode-name "dylan")
  817.   (setq local-abbrev-table dylan-mode-abbrev-table)
  818.   (dylan-mode-variables))
  819.  
  820. (if (fboundp 'font-lock-mode)
  821.     (progn
  822.       ;; We must use the "indentation" syntax table when doing font-lock
  823.       ;; processing.  This ugly hack should do the right thing, even if
  824.       ;; font-lock mode complains if you try to turn it off later.
  825.       (defvar old-after-change-function nil
  826.     "Used to modify the behavior of font-lock-mode.")
  827.       (defun dm-after-change-function (&rest args)
  828.     (let ((old-syntax-table (syntax-table)))
  829.       (unwind-protect
  830.           (progn
  831.         (set-syntax-table dylan-indent-syntax-table)
  832.         (apply old-after-change-function args))
  833.         (set-syntax-table old-syntax-table))))
  834.  
  835.       ;; See font-lock-mode for details.  It's ugly, but it works.
  836.       (setq dylan-font-lock-keywords
  837.         (list dyl-end-keyword-pattern
  838.           dyl-keyword-pattern
  839.           separator-word-pattern
  840.           "[-_a-zA-Z?!*@<>$%]+:"
  841.           "#rest\\|#key\\|#next"
  842.           dyl-other-pattern
  843.           '("\\b\\(define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\primary\\|open\\)\\)*[ \t]+\\(class\\|method\\|generic\\|variable\\|constant\\)\\)\\b[ \t]+\\(\\w+\\)" 1
  844.             font-lock-keyword-face t)
  845.           '("\\b\\(define\\([ \t\n]+\\(sealed\\|open\\|abstract\\|concrete\\|primary\\|open\\)\\)*[ \t]+\\(class\\|method\\|generic\\|variable\\|constant\\)\\)\\b[ \t]+\\(\\(\\s_\\|\\w\\)+\\)" 5
  846.             font-lock-function-name-face)
  847.           '("\\bend[ \t]+\\w*\\b[ \t]+\\(\\(\\s_\\|\\w\\)+\\)" 1
  848.             font-lock-function-name-face)
  849.           '("\\b\\(\\(\\s_\\|\\w\\)*\\)(" 1 font-lock-function-name-face)))
  850.       ;; More hacks to magically switch syntax tables as necessary
  851.       (add-hook
  852.        'font-lock-mode-hook
  853.        '(lambda ()
  854.       (if (not (eq major-mode 'dylan-mode))
  855.           nil
  856.         (setq font-lock-keywords dylan-font-lock-keywords)
  857.         (make-variable-buffer-local 'old-after-change-function)
  858.         (setq old-after-change-function 'font-lock-after-change-function)
  859.         (make-variable-buffer-local 'after-change-function)
  860.         (setq after-change-function 'dm-after-change-function))))))
  861.  
  862. (provide 'dylan-mode)
  863.